# Execute Methods
# 
###############################################################################
#' Pads numbers with leading zeros to the desired length.
#' 
#' If the length of the number passed to pad is larger than the target length an unpadded string representation
#' of that number is returned. 
#' @param x A vector of numbers
#' @param paddedLength the length of the string after padding.
#' @return A character vector of padded numbers. 
pad <- function(x,paddedLength)
{
    str <- as.character(x)
    zero_count <- paddedLength-nchar(str)
    if (zero_count < 0)
        zero_count <- 0
    paste(c(rep("0",zero_count),str),sep="",collapse="")
}

# see documentation below
setGeneric(name="execute",
        def=function(protocolApplication) standardGeneric("execute") )
#' Executes the analysis pipeline defined by the action in the ProtocolApplication
#'
#' For details on defining an analysis pipeline see the package vingette.
#' \code{execute} has two different behaviors, if the action of the protocol application is \code{\link{protocolList}}
#' input data and parameters are ignored. Instead the child protocol applications specified in the protocol 
#' definition are created and executed in the order in which they appeared.
#' 
#' For any other action a set of input data is loaded into memory and the action is applied to the data.
#' It is assumed that the order of input data in a set matches the order of parameters to the action. The first
#' parameter is the protocol application, which is implicit.
#' The value returned by the action is either written to the global R environment or to disk, if the
#' parameter \code{outputData} is set in the protocol definition. The name of the variable or file containing the
#' output data is given by:
#' The name of the protocol application, the action executed and the position of the input data set in the list of
#' input data sets, starting with 1, all separated by an underscore
#' These steps will be iterated over the list of input data sets.
#' If no input data is specified the action is executed only once with the protocol application as the only parameter.
#' Actions with no input data can useful for generating artificial data sets. The handling of output data is the
#' same as in the case with input data present, except for the list position which is not appended to the base file 
#' name.  
#' @param protocolApplication The protocol application to be executed.
#' @return execute invisibly returns NULL
#' @export
#' @author Bastian R. Angermann \email{angerb@@gmx.de}
#' @aliases execute execute-methods execute,ProtocolApplication-method
setMethod("execute", signature(protocolApplication="ProtocolApplication"), function (protocolApplication){
        tryCatch({ # User interrupt
                        protocolApplication <- .setInputData(protocolApplication,protocolApplication@.dataLocationFile)  
                
                        if (getwd() != protocolApplication@workingDirectory)
                                setWorkingDirectory( protocolApplication@workingDirectory)
                                
                 
                            startReport(protocolApplication@report,protocolApplication@name)    
                            if (is.null(protocolApplication@.parent)) 
                            {
                                    reportSummary(protocolApplication,protocolApplication@report)
                            }       
                        
                        if( (computeNodeNo>1) & is.null(protocolApplication@cluster))
                        { 
                                processNo <- computeNodeNo
                                cluster <- makeCluster(rep("localhost",processNo),type="SOCK",outfile="")
                                clusterEvalQ(cluster,library(drDobus)) 
                                protocolApplication@cluster <- cluster   
                        } 
                        summaryData <- NULL   
                        actionName <- attr(protocolApplication@.action, which="name")
                        summarySemantics <- as.null()
                        if (actionName == "protocolList") # Ignore input data execute child protocols
                                do.call(what=protocolApplication@.action,args=list("protocolApplication"=protocolApplication))
                        else { # execute the Action:
                                currentFile <- 0
                                baseName <- getBaseName(protocolApplication)
                    
                                if (is.null(protocolApplication@.inputData)) # Action has no input Data
                                {
                                        result <- do.call(what=protocolApplication@.action, args=list("protocolApplication"=protocolApplication))
                                        gc() # force cleanup of memory some protocols are real memory hogs and the automatic gc doesn't to a great job 
                                        fileName <- baseName
                                        if (!is.null(protocolApplication@outputData))
                                                writeData(result$main, fileName)
                                        else
                                                fileName <<- result$main
                                        if (!is.vector(result$summary))
                                                submitToLog(paste("Action",actionName,"returned summary information which is not a vector."),"Error")
                                        summaryData <- rbind(summaryData,result$summary)
                                        summarySemantics <- result$summarySemantics
                                } else 
                                { 
                                        if (!is.null(protocolApplication@cluster))
                                                actionResults <- parLapply(protocolApplication@cluster,protocolApplication@.inputData,runAction,protocolApplication)
                                       else
                                               actionResults <- lapply(protocolApplication@.inputData,runAction,protocolApplication)
                                        
                                   
                                        ordering <- sapply(actionResults,function(x) x$index)
                                        outputFiles <- sapply(actionResults,function(x) x$outFile)
                                        outputFiles <- outputFiles[ordering] # ensure correct order.
                                        summaryData <- sapply(actionResults,function(x) x$summaryData)
                                        # the return value of sapply is either matrix or vector we need to manually check the type and ensure proper handling.
                                        if (length(actionResults)>1) # we have a matrix, unless the summary of each action only has one element.
                                        {
                                            if (length(actionResults[[1]]$summaryData)>1) # matrix
                                            {
                                                summaryData <- t(summaryData)
                                                summaryData <- summaryData[ordering,1:ncol(summaryData),drop = FALSE]# ensure correct order.
                                            } else
                                            {
                                                summaryData <- matrix(summaryData,ncol=1)[ordering,,drop=FALSE]
                                            }
                                        } else
                                        {
                                            summaryData <- matrix(summaryData,nrow=1)  
                                        }
                                            

                                        
                                        summarySemantics <- actionResults[[1]]$summarySemantics
                                        itemList <- lapply(actionResults,function(x) x$reportItems)
                                        itemlist <- itemList[ordering]# ensure correct order.
                                        lapply(itemList,function(x) lapply(x,eval))
                                        
                                        if (!all(sapply(outputFiles,is.null)))
                                        { 
                                            listFileName <- getListFileName(protocolApplication)
                                         if (!is.null(protocolApplication@outputData))
                                                  writeCsvFileList(file=listFileName,outputFiles)
                                           else
                                                  listFileName <<- outputFiles
                                        }
                                }#has input data
                                # write summary data.
                                if (!is.null(summarySemantics))
                                { 
                                        colnames(summaryData) <- summarySemantics
                                        summaryFileName <- paste(baseName,"Summary",sep="_")
                        
                                        if (!is.null(protocolApplication@outputData))
                                               writeData(file=summaryFileName,summaryData)
                                        else
                                              summaryFileName <<- summaryData
                                }
                        }# is protocolList
                }, # end of try block
                interrupt=function(x){finalizeReport(protocolApplication@report);
                        if (!is.null(protocolApplication@cluster)) stopCluster(protocolApplication@cluster);submitToLog("Pipeline execution interrupted","Error") } ) 
    
        
        successNote <- paste("Action",actionName,"in protocol application",protocolApplication@name,"successfully executed.")
        addToReport(protocolApplication@report,successNote)
        # add link to summary data
        if (!is.null(summarySemantics))
        { 
              startReport(protocolApplication@report, paste(protocolApplication@name, "summary", sep="."))
              addToReport(protocolApplication@report,paste("Summary of", protocolApplication@name),summaryData)
              finalizeReport(protocolApplication@report) 
        }
        
        finalizeReport(protocolApplication@report)
        
        if (is.null(protocolApplication@.parent)) # stop reporting/cluster if necessary
        {
                if (!is.null(protocolApplication@cluster)) stopCluster(protocolApplication@cluster)
        }
        
        invisible(NULL)
})

#' Applies an action to a single input data set
#'
#' @param currentFileList List of input files for the action. Must be an element of the .inputData element of a protocolApplication
#' @param protocolApplication The protocolApplication that triggered the action. 
runAction <- function(currentFileList,protocolApplication) # TODO get rid of the protocollAppliation argument
{
    arguments <- as.list(formals(fun=protocolApplication@.action))
    varyingArgumentNo <- length(names(arguments))-1
    arguments$"protocolApplication" <- protocolApplication
    baseName <- getBaseName(protocolApplication)
    actionName <- attr(protocolApplication@.action, which="name")
    # TODO handle mismatch, switch to name matching if we have better tools of building input specifications.
    i <- 1;
# TODO move test outside of apply    
#    if ( (currentFile==1) & ( varyingArgumentNo != length(currentFileList)) )
#        submitToLog(paste("Number of arguments provided does not match number of arguments of action",actionName),"Note")
    if (varyingArgumentNo > 0)
    {  
        theArguments <- names(arguments)
        theArguments <- theArguments[!theArguments %in% "protocolApplication"]# all but protocolApplication
        
        theArguments <- theArguments[1:min(varyingArgumentNo,length(currentFileList))]
        
        for (argument in theArguments ) 
        {  
            file <- currentFileList[[i]]
            arguments[[argument]] <- readData(file)
            i <- i+1
        }
             
    }
    
    result <- do.call(what=protocolApplication@.action, args=arguments)
    
    if(class(result)!="list")
        submitToLog(paste("Action",actionName,"returned a result that is not a list"),"Error")
    if ( !identical(sort(names(result)),sort(c("main","summary","summarySemantics"))) )
        submitToLog(paste("Action",actionName,"returned a list with components that are not 'main', 'summary' and 'summarySemantics' "),"Error")
    
    InputDataSetNo <- length(protocolApplication@.inputData)
    currentFile <- which(sapply(protocolApplication@.inputData ,function(x) identical(x,currentFileList)))
    if (length(currentFile)>1) submitToLog("Replicate Input file sets","Error")
    
    if (!is.null(result$main))
    { 
        fileNumber <- pad(currentFile,ceiling(log( InputDataSetNo,base=10)))
        fileName <- paste(baseName, fileNumber, sep="_")
        
        if (!is.null(protocolApplication@outputData))
            writeData(result$main,fileName)
        else
            eval(substitute(assign(theName, result$main, globalenv() ),list(theName=fileName) ) )  
    }
    else
    {
        fileName <- as.null()
    }
    
    if (! (is.vector(result$summary)| is.null(result$summary) ))
        submitToLog(paste("Action",actionName,"returned summary information which is not a vector."),"Error")          
    
    summarySemantics <- result$summarySemantics
    rm("arguments","argument","theArguments")
    
    reportItems <- getValue(protocolApplication@report,"item")
    rm("item",envir=protocolApplication@report@referenceContainer)
    
    return (list(index=currentFile,outFile=fileName,summaryData=result$summary,summarySemantics=summarySemantics,reportItems=reportItems))
}